EnigmA Amiga Run 1996 February/EnigmA AMIGA RUN 04 (1996)(G.R. Edizioni)(IT)[!][issue 1996-02][Skylink CD III].iso/earcd/comm2/zpont311.lha/zpoint-3.11/Rexx/RequestCL.zprx.old

Text File | 1995-08-21 | 10KB | 331 lines

/*
   $VER: RequestCL 1.12 (17.8.95) von Albert Weinert und Ralph Seichter

   Das Skript benötigt Jürgen Kohrmeyer's "rexxtricks.library" und
   Ralph Seichter's "Zodiac's Point" V37.180 oder besser bzw. Oliver
   Wagner's "MicroDot" V1.10 oder besser.


   FUNKTIONSBESCHREIBUNG:

   Dieses Skript durchsucht eine 'Neue Files vom ...' Nachricht vom
   Connectline-eigenen 'Mailer-Daemon' nach bestellbaren Dateien. Alle
   gefundenen Dateien werden alphabetisch sortiert in einem Fenster auf
   dem entsprechenden Screen dargestellt. Hier können Sie die gewünschten
   Dateien bestellen, Multi-Select ist dabei möglich.


   INSTALLATION:

   Bei Zodiac's Point:

      Kopieren sie dieses Skript unter dem Namen "RequestCL.zprx" ins
      Rexx-Verzeichnis von ZP. Sie können es dann an das Gadget [Bestellen]
      binden, indem Sie in der Datei "maps/request.zp" den Text

         .key FILE/A,SCREEN/A
         .bra {
         .ket }
         Delete >NIL: {FILE}
         Run >NIL: SYS:Rexxc/RX ZP:Rexx/RequestCL.zprx {SCREEN}

      eintragen (bitte passen Sie ggf. den Pfad für 'RX' an).

   Bei Microdot:

      Das Programm unter dem Namen "RequestCL.mdmrexx" in das Rexx
      Verzeichnis von Microdot kopieren.

   ANPASSEN DES SKRIPTS:

   Am Anfang des Skripts können einige Parameter eingestellt werden:

   mapsadr     - Adresse des MAPS-Dienstes.

   maildemon   - Absendermuster für Mailer-Dämon.

   boardindex  - Betreffmuster für Inhaltsverzeichnisse von Brettern.

   requestcmd  - MAPS-Befehlt zum Bestellen von Nachrichten.

   usebrackets - Sollen MID-Klammern <> benutzt werden?

   board.count - Siehe Erklärung weiter unten.

   board.i.[p] - Parameter 'p' für Struktur mit Index 'i'. Für 'p' sind
                 die folgenden Einträge definiert:

   pattern     - Das Skript prüft, ob es in einem Brett aufgerufen wurde,
                 dessen Name auf das hier definierte Muster paßt. Trifft
                 dies zu, werden die weiteren Parameter genutzt.

   showfilesz  - Sollen Dateilängen angezeigt werden (1 = ja, 0 = nein)?

   showboards  - Sollen Brettnamen angezeigt werden?

   discard     - Bestimmt den Text, bis zu dem der Brettname abgeschnitten
                 werden soll. Das Abschneiden erfolgt bei dem am weitesten
                 rechts in Namen gefundenen Auftreten des Textes.

   showreadme  - Sollen #?.readme Dateien angezeigt werden?

   comments    - Sollen die Kurzkommentare angezeigt werden?

   boardnamesz - Anzahl der Zeichen pro Brettname.

   filenamesz  - Anzahl der Zeichen pro Dateiname.

   winwidth    - Gesamtbreite des Fensters in Pixeln.
*/


mapsadr      = 'maps'
maildemon    = 'Newfiles@#?'
boardindex   = 'Re#?INHALT'
requestcmd   = 'REQUEST'
usebrackets  = 0

/* 'board.count' gibt den Index der letzten definierten Parameterstruktur
   an. Wenn Sie also als letzten Eintrag 'board.9.winwidth' benutzen, muß
   die folgende Zeile in 'board.count = 9' geändert werden. */

board.count = 2

board.0.pattern      = '#?AMINET'   /* Parameter für Aminet-Bretter */
board.0.showfilesz   = 1
board.0.showboards   = 1
board.0.discard      = 'AMINET/'    /* Entferne das führende 'AMINET/' */
board.0.showreadme   = 0            /* von den Brettnamen.             */
board.0.showcomments = 1
board.0.boardnamesz  = 11
board.0.filenamesz   = 20
board.0.winwidth     = 813

board.1.pattern      = '#?/FAQ'  /* Parameter für FAQ-Bretter */
board.1.showfilesz   = 1
board.1.showboards   = 1
board.1.discard      = ''
board.1.showreadme   = 0
board.1.showcomments = 0
board.1.boardnamesz  = 12
board.1.filenamesz   = 60
board.1.winwidth     = 813

board.2.pattern      = '#?'      /* Parameter für alle übrigen Bretter. */
board.2.showfilesz   = 1         /* Der Eintrag für 'pattern' muß '#?'  */
board.2.showboards   = 1         /* lauten, ändern Sie das niemals!     */
board.2.discard      = ''
board.2.showreadme   = 1
board.2.showcomments = 1
board.2.boardnamesz  = 35
board.2.filenamesz   = 30
board.2.winwidth     = 813



/********************************************************************/
/*** !!! BITTE AENDERN SIE UNTERHALB DIESER ZEILE NICHTS MEHR !!! ***/
/********************************************************************/

OPTIONS RESULTS

IF (~SHOW('LIBRARIES', 'rexxtricks.library') & ~ADDLIB('rexxtricks.library', 0, -30, 0)) THEN DO
   requestnotify 'Kann rexxtricks.library nicht öffnen!'
   EXIT(5)
END

IF (~SHOW('LIBRARIES','rexxsupport.library') & ~ADDLIB('rexxsupport.library', 0, -30, 0)) THEN DO
   requestnotify 'Kann rexxsupport.library nicht öffnen!'
   EXIT(5)
END

rexxport = ADDRESS()

IF MATCHPATTERN(rexxport, "MICRODOT#?") THEN
   md = 1
ELSE
   md = 0

IF md THEN
   getmdpubscreenname var pubscreen
ELSE DO
   PARSE ARG rexxport
   rexxport = COMPRESS(rexxport)
   IF rexxport = '' THEN
      rexxport = 'ZPoint'
   ADDRESS VALUE rexxport
   pubscreen = rexxport
END

IF md THEN DO
   getcurrentboard stem brett.
   boardname = brett.name
END
ELSE DO
   boardinfo label
   boardname = result
END

disc = ''
DO i = 0 TO board.count
   IF MATCHPATTERN(boardname, board.i.pattern) THEN DO
      showfilesz   = board.i.showfilesz
      showboards   = board.i.showboards
      showreadme   = board.i.showreadme
      showcomments = board.i.showcomments
      boardnamesz  = board.i.boardnamesz
      filenamesz   = board.i.filenamesz
      winwidth     = board.i.winwidth
      disc         = board.i.discard
      LEAVE i
   END
END

IF md THEN DO
   getcurrentmailheader ABS var absender
   getcurrentmailheader BET var betreff
END
ELSE DO
   messageinfo author
   absender = RESULT
   messageinfo fullsubject
   betreff = RESULT
END

fromdemon = MATCHPATTERN(absender, maildemon)
IF (~fromdemon & ~MATCHPATTERN(betreff, boardindex)) THEN DO
   requestnotify 'Unbekanntes Nachrichtenformat!'
   EXIT(5)
END

inname  = 'T:1-RequestCL.zpmd'
outname = 'T:2-RequestCL.zpmd'
IF md THEN DO
   extractcurrentmail inname
   IF RC THEN DO
      request '"Kann Nachricht nicht speichern!"' 'Schade'
      EXIT(5)
   END
END
ELSE DO
   savemessagebody inname
   IF ~RC THEN DO
      requestnotify 'Kann Nachricht nicht speichern!'
      EXIT(5)
   END
END

IF ~READFILE(inname, 'line') THEN DO
   IF md THEN
      request '"Kann 'inname' nicht lesen!"' 'Schade'
   ELSE
      requestnotify 'Kann 'inname' nicht lesen!'
   EXIT(5)
END

IF ~md THEN
   'guilock text="Bitte haben Sie Geduld..."'

CALL ParseBody

dummy = DELETE(inname)

windef.pubscreen = pubscreen
windef.title     = 'Zu bestellende Nachrichten auswählen'
windef.postext   = '_Bestellen'
windef.negtext   = '_Abbruch'
windef.sort      = 'TRUE'
windef.font      = 'DEFAULT'
windef.width     = winwidth
IF VIEWLIST('string', 'windef', 'destvar') THEN DO
   IF ~OPEN('temp2', outname, 'WRITE') THEN DO
      BEEP()
      EXIT(5)
   END
   smail = 0
   DO i = 0 TO destvar.count - 1
      x = LSEARCH(destvar.i, 'string')
      IF x ~= (-1) THEN DO
         dummy = WRITELN('temp2', entry.x)
         smail = 1
      END
   END
   dummy = CLOSE('temp2')
   IF smail THEN DO
      IF md THEN DO
         sendmail 'to='mapsadr' bodyfile='outname' subject='requestcmd
         IF RESULT = '' THEN DO
            request '"Kann Bestellung nicht verschicken!"' 'Schade'
            EXIT(5)
         END
      END
      ELSE DO
         writemessage 'file='outname' receiver='mapsadr' subject='requestcmd
         IF RESULT = '' THEN DO
            requestnotify 'Kann Bestellung nicht verschicken!'
            EXIT(5)
         END
      END
   END
   ELSE
      dummy = DELETE(outname)
END

IF ~md THEN
   guilock off
EXIT(0)


/* Nachricht vom 'Mailer-Daemon' nach bestellbaren Files durchsuchen. */

ParseBody:
   mi = -1
   entries = 0
   DO i = 0 TO line.count - 1
      IF i > mi THEN DO
         IF ((fromdemon & LEFT(line.i, 25) = 'Neue Nachrichten im Brett') | (~fromdemon & LEFT(line.i, 19) = '-- Inhalt von Brett')) THEN
            currentboard = LEFT(WORD(line.i, 5), LENGTH(WORD(line.i, 5)) - 1)
         IF DATATYPE(WORD(line.i, 3)) = 'NUM' THEN DO
            mi = 0;
            DO j = i + 2 UNTIL (mi > 0 | j >= line.count)
               IF WORD(line.j, 1) = '>Msg-ID:' THEN mi = j
            END
            IF mi = 0 THEN
               use = 0
            ELSE
               use = 1
            IF ~showreadme THEN
               IF MATCHPATTERN(line.i, '#?.readme#?') THEN
                  use = 0
            IF use THEN DO
               mid = WORD(line.mi, 2)
               IF (~usebrackets & LEFT(mid, 1) = '<') THEN
                  mid = SUBSTR(mid, 2, LENGTH(mid) - 2)
               entry.entries = currentboard' 'mid
               string.entries = SUBWORD(SUBSTR(line.i, 43), 1)
               comment = ''
               IF showcomments THEN
                  DO j = i + 2 TO mi - 2
                     comment = comment' 'STRIP(SUBSTR(line.j, 43), 'T')
                  END
               IF showfilesz THEN
                  string.entries = LEFT(string.entries, filenamesz)' 'RIGHT(WORD(line.i, 3), 7)' 'comment
               IF showboards THEN DO
                  tempboard = currentboard
                  IF disc ~= '' THEN DO
                     pos = LASTPOS(disc, currentboard)
                     IF pos >= 1 THEN
                        tempboard = SUBSTR(currentboard, pos + LENGTH(disc))
                  END
                  string.entries = LEFT(tempboard, boardnamesz)' 'string.entries
               END
               entries = entries + 1
            END
         END
      END
   END
   string.count = entries
RETURN

/* EOF */